perm filename TEST.SAI[8,ALS] blob
sn#043236 filedate 1973-05-23 generic text, type T, neo UTF8
00100 BEGIN "TEST"
00200 DEFINE ⊂="COMMENT"; ⊂ 12/11/72;
00300
00400 REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00500 REQUIRE "BLOCKS.HDR[SYS,THO]" SOURCE_FILE;
00600 REQUIRE "SIG" LOAD_MODULE;
00700 INTEGER DPPOINT,DPP1,DPP2,DATSHIFT,HPOINT;
00800 EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00900 EXTERNAL STRING PROCEDURE INCHWL;
01000 EXTERNAL PROCEDURE SPOOL(STRING S; INTEGER IOCHAN,FLAGS);
01100 DEFINE DATSIZ="1280",BUFEXS="43",BUFSIZ="1323";
01200 DEFINE BYTE="((ILDB(BPT) LSH 24)%2↑24)",BPS="12",LBYT="ILDB(LBPT)";
01300 DEFINE LBYTE="((ILDB(LBPT) LSH 24)%2↑24)";
01400 STRING FILI,TFILEI,TFILE,FILEI,OPT0,OPT1,OPT2,OPT3,OPT4;
01500 INTERNAL INTEGER ARRAY DATBUF[0:4000];
01600 INTEGER ARRAY LFILE,MFILE[0:'177];
01700 REAL X,SX;
01800 INTEGER XX,YY,ZZ;
01900 ⊂ INTEGER ARRAY D[0:992];
02000 INTEGER CHAN4,CHAN6,EOF,IEOF;
02100 INTEGER BPT,BPTFST,BPTSAV,LBPT,SEGCNT,SEGTOT;
02200 INTEGER H,I,J,K,L;
02300 INTERNAL INTEGER M,N,P,RATE,STEPS,INFLAG,FLAG;
02400 INTERNAL INTEGER SEGC,SEGMRK,SEGSAV,SEGLIM;
02500 INTERNAL INTEGER INTOT,PONY,HINT,UPCNT,TEACH;
02600 INTERNAL INTEGER I1L,I1H,I2L,I2H,I3L,I3H, INL,INH,NZRNG,
02700 FP1L,FP1H,FP2L,FP2H, ILPB,ILPC, IHPB,IHPC ;
02800 INTERNAL INTEGER TFLAG,ZEROF,ZEROC;
02900 LABEL START,LABELA,LABELB,ZZZZ,START1,FINISH,START2;
03000 STRING READ1,READ2,PREHINT,STEPX,STPMOD;
03100 INTEGER HCOUNT,HINDEX;
03200
03300 ⊂ REAL ARRAY CONMAT[0:35,0:35]; ⊂ space for confusion matrix;
03400 INTEGER ARRAY OCCURS,SEGOCC[0:35]; ⊂ space for phonette occurences and seg counts;
03500 INTEGER ARRAY LEV1,SEG1,SEG2[0:150]; INTEGER CON1; ⊂ use for feature study ;
03600 INTEGER ARRAY TOTFEA,SPEFEA,NONSPE[0:35]; ⊂ use for feature counts;
03700 INTEGER ARRAY FEAMAT[0:35,0:35]; ⊂ use to see if features alone suffice;
03800
03900
04000
04100 DEFINE ⊂="COMMENT",CR="'15",LF="'12",FF="'14",TB="'11";
04200 DEFINE CRLF="CR&LF", CRLF0="CR&'177&'21"; ⊂ FOR CRLF W/O FORM FEED;
04300 DEFINE TTY="'14",DSK="'13",BDSKO="'12",DPY="'11",BDSKI="'10",TMP="'0";
04400
04500 INTERNAL PROCEDURE LOOKIN(INTEGER CHAN; REFERENCE STRING FILENAME);
04600 BEGIN ⊂ REQUIRES SETBREAK(1,CR,LF,"IN");
04700 BOOLEAN NF;
04800 LOOKUP(CHAN,FILENAME,NF);
04900 WHILE NF DO
05000 BEGIN
05100 OUTSTR(CR&LF&"Can't find "&FILENAME&". File=");
05200 FILENAME ← INPUT(TTY,1);
05300 LOOKUP(CHAN,FILENAME,NF)
05400 END;
05500 END "LOOKIN";
05600
05700
05800
05900
06000 PROCEDURE REPORT;
06100 BEGIN "REP"
06200 STRING LAB; INTEGER OUT,I,J,K,L;
06300 IF TFLAG≠0 THEN BEGIN
06400 TFLAG←0;
06500 FOR I←0 STEP 5 UNTIL TBLSIZ DO BEGIN
06600 IF TABLET[I+1]=0 THEN DONE ELSE
06700 IF (LDB(POINT(2,TABLET[I+2],12)))>0 THEN BEGIN "CT"
06800 J←TABLET[I+1] LAND '000077777777 ;
06900 IF J≠0 THEN BEGIN "IN"
07000 ⊂ OUTSTR(CRLF&CVS(CON1)&TB&CVOS(TABLET[I+1])&TB&CVXSTR(TABLET[I+1]));
07100 LEV1[CON1]←TABLET[I+1];
07200 SEG1[CON1]←LDB(POINT(15,TABLET[I],17));
07300 SEG2[CON1]←LDB(POINT(15,TABLET[I],35))+SEG1[CON1] ;
07400 CON1←CON1+1; IF CON1>150 THEN BEGIN OUTSTR(CRLF&"Counter space exhausted");
07500 CON1←149 END;
07600 END "IN";
07700
07800 TABLET[I+2]←TABLET[I+2] LAND '770000000000; END "CT"; END; END;
07900 END "REP";
08000
08100
08200
08300
08400
08500
08600
08700 PROCEDURE ACCFEA;
08800 BEGIN "ACCFEA" INTEGER I,J,K,L,P1,P2,N1,N2; LABEL S,S1;
08900
09000 I←21; ⊂ Index over header hints;
09100 WHILE I>0 DO BEGIN
09200 L←MFILE[I]; IF L=0 THEN DONE;
09300 P1←(LDB(POINT(12,L,11))) LSH 24;
09400 ⊂ P2←(LDB(POINT(12,L,23))) LSH 24;
09500 ⊂ IF P1≠P2 THEN GOTO S;
09600 N1←LDB(POINT(12,L,23)); ⊂ START SEG;
09700 N2←N1+LDB(POINT(12,L,35)); ⊂ END SEG;
09800 FOR K←0 STEP 1 UNTIL 35 DO
09900 IF P1=PHLIST[K] THEN DONE
10000 ELSE IF PHLIST[K]=0 THEN BEGIN K←0; DONE END;
10100 ⊂ this hint is Kth in the list;
10200
10300
10400 HPOINT←POINT(1,HLIST[K],-1); ⊂ Get TOTFEA set for this hint;
10500 FOR L←0 STEP 1 UNTIL 35 DO
10600 IF (ILDB(HPOINT))=1 THEN TOTFEA[L]←TOTFEA[L]+N2-N1;
10700
10800
10900
11000 FOR J←0 STEP 1 UNTIL CON1-1 DO BEGIN "OVERCNT"
11100 INTEGER I1,I2;
11200 I1←SEG1[J]; I2←SEG2[J];
11300 IF N1>I2 THEN GOTO S1;
11400 IF N2<I1 THEN GOTO S1; ⊂ no overlap bet hint and this counter;
11500
11600 IF N1>I1 THEN I1←N1;
11700 IF N2<I2 THEN I2←N2; ⊂ I2-I1 gives the overlap;
11800
11900 FOR L←0 STEP 1 UNTIL 35 DO
12000 IF LEV1[J]=FLIST[L] THEN DONE
12100 ELSE IF FLIST[L]=0 THEN BEGIN OUTSTR(CRLF&"Undefined feature = "&
12200 CVXSTR(LEV1[J])); L←25 ; DONE END;
12300 ⊂ This counter is for Lth feature;
12400
12500 IF (LDB(POINT(1,HLIST[K],L)))=1 THEN SPEFEA[L]←SPEFEA[L]+I2-I1
12600 ELSE NONSPE[L]←NONSPE[L]+I2-I1;
12700
12800
12900 FEAMAT[L,K]←FEAMAT[L,K]+I2-I1; ⊂ gen a matrix feature/hints;
13000
13100 IF TOTFEA[L]<SPEFEA[L] THEN BEGIN
13200 OUTSTR(CRLF&CVXSTR(P1)&TB&CVS(N1)&TB&CVS(N2)&TB&CVS(K));
13300 OUTSTR(CRLF&CVS(J)&TB&CVXSTR(LEV1[J])&TB&CVS(I1)&TB&CVS(I2));
13400 OUTSTR(CRLF&CVS(TOTFEA[L]-SPEFEA[L])); SPEFEA[L]←TOTFEA[L]; INCHWL; END;
13500
13600
13700
13800 S1: END "OVERCNT";
13900
14000 S: I←I+1; END; ⊂ ends WHILE I>0 loop;
14100
14200 END "ACCFEA";
14300
14400
14500 PROCEDURE DISFEA;
14600 BEGIN INTEGER I,J,K;
14700
14800 OUTSTR(CRLF&"Feature"&TB&"Given"&TB&"Found"&TB&"Excess"&TB&"%Found"&TB&
14900 "%Excess"&CRLF);
15000
15100 FOR I←0 STEP 1 UNTIL 35 DO IF TOTFEA[I]≠0 THEN BEGIN
15200 J←(SPEFEA[I]/TOTFEA[I])*100.+.5;
15300 K←(NONSPE[I]/TOTFEA[I])*100.+.5;
15400 OUTSTR(CRLF&CVXSTR(FLIST[I])&TB&CVS(TOTFEA[I])&TB&CVS(SPEFEA[I])&TB&
15500 CVS(NONSPE[I])&TB&CVS(J)&TB&CVS(K));
15600 END;
15700
15800 END;
15900
16000
16100
16200
16300 PROCEDURE LISFEA;
16400 BEGIN INTEGER I,J,K;
16500
16600 OUT(6,CRLF&"Feature"&TB&"Given"&TB&"Found"&TB&"Excess"&TB&"%Found"&TB&
16700 "%Excess"&CRLF);
16800
16900 FOR I←0 STEP 1 UNTIL 35 DO IF TOTFEA[I]≠0 THEN BEGIN
17000 J←(SPEFEA[I]/TOTFEA[I])*100.+.5;
17100 K←(NONSPE[I]/TOTFEA[I])*100.+.5;
17200 OUT(6,CRLF&CVXSTR(FLIST[I])&TB&CVS(TOTFEA[I])&TB&CVS(SPEFEA[I])&TB&
17300 CVS(NONSPE[I])&TB&CVS(J)&TB&CVS(K));
17400 END;
17500
17600 OUTSTR(CRLF&"Subtitle for the table = ");
17700 OPT3←INCHWL; OUT(6,CRLF&CRLF&" "&OPT3&CRLF&'14);
17800
17900
18000 END;
18100
18200
18300
18400 PROCEDURE FEMATLIS;
18500 BEGIN INTEGER I,J,K; INTEGER ARRAY VLAB,HLAB[0:35];
18600
18700 FOR I←0 STEP 1 UNTIL 35 DO BEGIN
18800 VLAB[I]←PHLIST[I]; HLAB[I]←FLIST[I] END;
18900
19000 VLAB[0]←1; FOR J←0 STEP 1 UNTIL 35 DO BEGIN
19100 FOR I←0 STEP 1 UNTIL 35 DO IF FEAMAT[I,J]≠0 THEN DONE;
19200 IF I≥35 THEN VLAB[J]←1;
19300 FOR I←0 STEP 1 UNTIL 35 DO IF FEAMAT[J,I]≠0 THEN DONE;
19400 IF I≥35 THEN HLAB[J]←1;
19500 END;
19600
19700 SETFORMAT(3,0); OUT(6,CRLF&CRLF&TB&" ");
19800 FOR I←1 STEP 1 UNTIL 35 DO BEGIN
19900 IF VLAB[I]=0 THEN DONE;
20000 IF VLAB[I]≠1 THEN BEGIN IF (VLAB[I] LSH 6)=0 THEN
20100 VLAB[I]←VLAB[I] LSH -6;
20200 OUT(6,CVXSTR(VLAB[I])[1 TO 3]);
20300 END;
20400 END;
20500
20600 FOR I←0 STEP 1 UNTIL 35 DO BEGIN
20700 IF HLAB[I]=0 THEN DONE;
20800 IF HLAB[I]≠1 THEN BEGIN
20900 OUT(6,CRLF&CVXSTR(HLAB[I])&TB);
21000 FOR J←1 STEP 1 UNTIL 35 DO
21100 IF VLAB[J]≠1 THEN BEGIN
21200 K←FEAMAT[I,J];
21300 IF K=0 THEN OUT(6," ") ELSE OUT(6,CVS(K));
21400 END;
21500 END;
21600 END;
21700
21800 OUT(6,CRLF&"SOC"&TB);
21900 FOR I←1 STEP 1 UNTIL 35 DO BEGIN
22000 IF VLAB[I]=0 THEN DONE;
22100 IF VLAB[I]≠1 THEN OUT(6,CVS(SEGOCC[I])); END;
22200 OUT(6,CRLF&'14);
22300
22400 END "FEMATLIS";
22500
22600
22700
00100 UPCNT←3;
00200 CHAN4←4; CHAN6←6;
00300 TABIN(INTOT);
00400 OPT3←0; OPEN(6,"DSK",0,0,2,0,0,0); ENTER(6,"TEST.DOC",0);
00500
00600
00700
00800 ⊂ **** MAIN ROUTINE STARTS HERE****;
00900 START:
01000 IF (TFILEI←STRIN(CRLF&
01100 "DATA FILE LIST = "))≠"" THEN FILEI←TFILEI ELSE GO TO START1 ;
01200 OUTSTR(CRLF);
01300 SETBREAK(1,'12,'15,"INS");
01400
01500 OPEN(5,"DSK",0,2,0,20,0,EOF);
01600 LOOKIN(5,TFILEI); EOF←0;
01700
01800 OPT4←STRIN(CRLF&"Do you want feature performance (YorCR) = ");
01900 CON1←0;
02000 START2: EOF←0; WHILE EOF=0 DO BEGIN "LOOP"
02100 IF INCHRS="X" THEN GOTO START1;
02200 FILEI←INPUT(5,1); OUTSTR(CRLF&"FILE = "&FILEI);
02300 IF FILEI="" THEN DONE;
02400 M←8; N←2↑M; INFLAG←0;
02500
02600 FOR I←0 STEP 5 UNTIL TBLSIZ-5 DO IF TABLET[I+1]=0 THEN DONE
02700 ELSE TABLET[I+2]←TABLET[I+2] LAND '770000000000;
02800 CLOSE(CHAN4);
02900 OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
03000 LOOKIN(CHAN4,FILEI);
03100 ⊂ EOF←0; SEGC←0; SEGCNT←0;
03200 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
03300 SEGTOT←(LFILE[0]*6)%N; RATE←LFILE[2];
03400 ⊂ OUTSTR(CRLF&"SAM RATE ="&CVS(LFILE[2])&CRLF);
03500 IF RATE=0 THEN RATE←CVD(STRIN("Sampling rate missing. Rate = "));
03600
03700 I←21; ⊂ Index over hints in header;
03800 WHILE I>0 DO BEGIN INTEGER P1,P2,DUR; LABEL L5;
03900 L←LFILE[I]; IF L=0 THEN DONE;
04000 P1←(LDB(POINT(12,L,11))) LSH 24;
04100 ⊂ P2←(LDB(POINT(12,L,23))) LSH 24;
04200 ⊂ IF P1≠P2 THEN GOTO L5;
04300 DUR←LDB(POINT(12,L,35));
04400 FOR N←0 STEP 1 UNTIL 63 DO IF PHLIST[N]=P1 THEN DONE
04500 ELSE IF PHLIST[N]=0 THEN BEGIN N←0; DONE END;
04600 OCCURS[N]←OCCURS[N]+1; SEGOCC[N]←SEGOCC[N]+DUR;
04700 L5: I←I+1; END;
04800
04900
05000
05100 FOR I←0 STEP 1 UNTIL 127 DO MFILE[I]←LFILE[I]; ⊂ retain a copy for feature eval;
05200
05300
05400 DATSHIFT←0;
05500
05600 LABELA: ⊂ Put all outputs into the off state;
05700 FOR I←0 STEP 5 UNTIL TBLSIZ-5 DO
05800 IF TABLET[I+1]≠0 THEN TABLET[I]←'777777777777 ELSE DONE;
05900 HINT←H←0; TABLES[2]←HLIST[0];
06000
06100 ARRYIN(CHAN4,DATBUF[0],SEGTOT*4); ⊂ Get data; CLOSE(CHAN4);
06200 BPT←POINT(6,DATBUF[0],-1); HINDEX←21; HCOUNT←0;
06300
06400 FOR SEGC←1 STEP 1 UNTIL SEGTOT DO BEGIN
06500 FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
06600 LABELB: SIG(P);
06700 REPORT; SETFORMAT(3,0);
06800 END;
06900
07000 FOR I←0 STEP 1 UNTIL INSIZ-1 DO INDAT[I]←0;
07100 FOR I←0 STEP 1 UNTIL 4 DO BEGIN SIG(P);
07200 REPORT; SEGC←SEGC+1; END;
07300
07400 IF OPT4="Y" THEN ACCFEA; CON1←0;
07500 END "LOOP";
07600
07700
07800 GO TO START;
07900 START1:
08000 IF OPT4="Y" THEN BEGIN IF STRIN(CRLF&"Show the feature performance? (YorCR) = ")="Y"
08100 THEN DISFEA;
08200 IF STRIN(CRLF&"List the table on TEST.DOC? (YorCR) = ")="Y" THEN
08250 BEGIN LISFEA; FEMATLIS; END;
08300 IF STRIN(CRLF&"Zero the feature counts? (YorCR) =")="Y" THEN BEGIN
08400 FOR I←0 STEP 1 UNTIL 35 DO TOTFEA[I]←SPEFEA[I]←NONSPE[I]←0;
08500 FOR I←0 STEP 1 UNTIL 35 DO FOR J←0 STEP 1 UNTIL 35 DO FEAMAT[I,J]←0;
08600 END;
08700
08800 END;
08900 IF STRIN(CRLF&"Are you through ? (YorCR) = ")="Y" THEN BEGIN RELEASE(6); GOTO FINISH; END;
09000 IF FILEI="" THEN GO TO START ELSE GO TO START2 ;
09100 FINISH:
09200 END "TEST";